start converting from System.Directory to System.OsPath

This is the start of a long road, got the first few files to compile
after this large change.

Sponsored-by: mycroft

diff --git a/Build/Configure.hs b/Build/Configure.hs
index cce9488bae4090f41805bc77f500d718ceb6195d..2c848ce965ae576f97c84da05a897d4a1bfcc79f 100644 (file)
--- a/Build/Configure.hs
+++ b/Build/Configure.hs
@@ -11,6 +11,7 @@ import Utility.SafeCommand
 import Utility.Env.Basic
 import qualified Git.Version
 import Utility.SystemDirectory
+import Utility.OsPath
 
 import Control.Monad
 import Control.Applicative
@@ -91,11 +92,11 @@ getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>
 
 setup :: IO ()
 setup = do
-       createDirectoryIfMissing True tmpDir
+       createDirectoryIfMissing True (toOsPath tmpDir)
        writeFile testFile "test file contents"
 
 cleanup :: IO ()
-cleanup = removeDirectoryRecursive tmpDir
+cleanup = removeDirectoryRecursive (toOsPath tmpDir)
 
 run :: [TestCase] -> IO ()
 run ts = do

diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs
index 5458612d4c2914d7ce3ec4d0ea86435f1628fb69..89a8027fa86ec8bb5aa8d77eea4123a981f4b445 100644 (file)
--- a/Build/TestConfig.hs
+++ b/Build/TestConfig.hs
@@ -8,6 +8,7 @@ import Utility.Path
 import Utility.Monad
 import Utility.SafeCommand
 import Utility.SystemDirectory
+import Utility.OsPath
 
 import System.IO
 import System.FilePath
@@ -106,7 +107,7 @@ findCmdPath k command = do
   where
        find d =
                let f = d </> command
-               in ifM (doesFileExist f) ( return (Just f), return Nothing )
+               in ifM (doesFileExist (toOsPath f)) ( return (Just f), return Nothing )
 
 quiet :: String -> String
 quiet s = s ++ " >/dev/null 2>&1"

diff --git a/Build/Version.hs b/Build/Version.hs
index e3b905919d06c536eb427dda38ac56f51e90ede7..3552814116ec39fd72bcf98e2671fd2f7260e391 100644 (file)
--- a/Build/Version.hs
+++ b/Build/Version.hs
@@ -73,4 +73,4 @@ writeVersion ver = catchMaybeIO (F.readFile' f) >>= \case
                , ""
                ]
        footer = []
-       f = toOsPath "Build/Version"
+       f = literalOsPath "Build/Version"

diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs
index 5a8f661ce5df14edf6416005b4a07887ad3e29e9..b604581fc6b4d8acd17b9006e905faf372b9656f 100644 (file)
--- a/Utility/FileIO.hs
+++ b/Utility/FileIO.hs
@@ -89,21 +89,44 @@ openTempFile p s = do
 #endif
 
 #else
--- When not building with OsPath, export FilePath versions
--- instead. However, functions still use ByteString for the
--- file content in that case, unlike the Strings used by the Prelude.
+-- When not building with OsPath, export RawFilePath versions
+-- instead.
 import Utility.OsPath
-import System.IO (withFile, openFile, openTempFile, IO)
+import Utility.FileSystemEncoding
+import System.IO (IO, Handle, IOMode)
+import Prelude ((.), return)
 import qualified System.IO
-import Data.ByteString.Lazy (readFile, writeFile, appendFile)
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+
+withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r 
+withFile = System.IO.withFile . fromRawFilePath
+
+openFile :: OsPath -> IOMode -> IO Handle
+openFile = System.IO.openFile . fromRawFilePath
+
+readFile :: OsPath -> IO L.ByteString
+readFile = L.readFile . fromRawFilePath
 
 readFile' :: OsPath -> IO B.ByteString
-readFile' = B.readFile
+readFile' = B.readFile . fromRawFilePath
+
+writeFile :: OsPath -> L.ByteString -> IO ()
+writeFile = L.writeFile . fromRawFilePath
 
 writeFile' :: OsPath -> B.ByteString -> IO ()
-writeFile' = B.writeFile
+writeFile' = B.writeFile . fromRawFilePath
+
+appendFile :: OsPath -> L.ByteString -> IO ()
+appendFile = L.appendFile . fromRawFilePath
 
 appendFile' :: OsPath -> B.ByteString -> IO ()
-appendFile' = B.appendFile
+appendFile' = B.appendFile . fromRawFilePath
+
+openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle)
+openTempFile p s = do
+       (t, h) <- System.IO.openTempFile
+               (fromRawFilePath p)
+               (fromRawFilePath s)
+       return (toRawFilePath t, h)
 #endif

diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs
index d80c9203f8740399c069a967a67095cfbc1b6672..95cd716c4b91912e63892af0fd0e9ebc3b12c116 100644 (file)
--- a/Utility/MoveFile.hs
+++ b/Utility/MoveFile.hs
@@ -46,7 +46,6 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
                rethrow = throwM e
 
                mv tmp () = do
-                       let tmp' = fromRawFilePath (fromOsPath tmp)
                        -- copyFile is likely not as optimised as
                        -- the mv command, so we'll use the command.
                        --
@@ -59,18 +58,18 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
                        ok <- copyright =<< boolSystem "mv"
                                [ Param "-f"
                                , Param (fromRawFilePath src)
-                               , Param tmp'
+                               , Param (fromRawFilePath (fromOsPath tmp))
                                ]
                        let e' = e
 #else
-                       r <- tryIO $ copyFile (fromRawFilePath src) tmp'
+                       r <- tryIO $ copyFile src tmp
                        let (ok, e') = case r of
                                Left err -> (False, err)
                                Right _ -> (True, e)
 #endif
                        unless ok $ do
                                -- delete any partial
-                               _ <- tryIO $ removeFile tmp'
+                               _ <- tryIO $ removeFile tmp
                                throwM e'
 
 #ifndef mingw32_HOST_OS        

diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs
index 5a62e61004dea1fcffede3dd1fc3f5d2da29f8b2..0567b647aba1330e106a3a5533095170d441fded 100644 (file)
--- a/Utility/OsPath.hs
+++ b/Utility/OsPath.hs
@@ -7,51 +7,68 @@
 
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.OsPath (
        OsPath,
        OsString,
+       literalOsPath,
        toOsPath,
        fromOsPath,
 ) where
 
 import Utility.FileSystemEncoding
-
 #ifdef WITH_OSPATH
 import System.OsPath
 import "os-string" System.OsString.Internal.Types
 import qualified Data.ByteString.Short as S
+#else
+import qualified Data.ByteString as S
+#endif
+
+class OsPathConv t where
+       toOsPath :: t -> OsPath
+       fromOsPath :: OsPath -> t
+
+instance OsPathConv FilePath where
+       toOsPath = toOsPath . toRawFilePath
+       fromOsPath = fromRawFilePath . fromOsPath
+
+{- Used for string constants. -}
+literalOsPath :: String -> OsPath
+literalOsPath = toOsPath
+
+#ifdef WITH_OSPATH
+instance OsPathConv RawFilePath where
+       toOsPath = bytesToOsPath
+       fromOsPath = bytesFromOsPath
 
 {- Unlike System.OsString.fromBytes, on Windows this does not ensure a
  - valid USC-2LE encoding. The input ByteString must be in a valid encoding
  - already or uses of the OsPath will fail. -}
-toOsPath :: RawFilePath -> OsPath
+bytesToOsPath :: RawFilePath -> OsPath
 #if defined(mingw32_HOST_OS)
-toOsPath = OsString . WindowsString . S.toShort
+bytesToOsPath = OsString . WindowsString . S.toShort
 #else
-toOsPath = OsString . PosixString . S.toShort
+bytesToOsPath = OsString . PosixString . S.toShort
 #endif
 
-fromOsPath :: OsPath -> RawFilePath
+bytesFromOsPath :: OsPath -> RawFilePath
 #if defined(mingw32_HOST_OS)
-fromOsPath = S.fromShort . getWindowsString . getOsString
+bytesFromOsPath = S.fromShort . getWindowsString . getOsString
 #else
-fromOsPath = S.fromShort . getPosixString . getOsString
+bytesFromOsPath = S.fromShort . getPosixString . getOsString
 #endif
 
 #else
-{- When not building with WITH_OSPATH, use FilePath. This allows
- - using functions from legacy FilePath libraries interchangeably with
- - newer OsPath libraries.
+{- When not building with WITH_OSPATH, use RawFilePath.
  -}
-type OsPath = FilePath
-
-type OsString = String
+type OsPath = RawFilePath
 
-toOsPath :: RawFilePath -> OsPath
-toOsPath = fromRawFilePath
+type OsString = S.ByteString
 
-fromOsPath :: OsPath -> RawFilePath
-fromOsPath = toRawFilePath
+instance OsPathConv RawFilePath where
+       toOsPath = id
+       fromOsPath = id
 #endif

diff --git a/Utility/Path.hs b/Utility/Path.hs
index de13712d3222e52bd82c6d78e4d59666247aabf0..493efcad1c0f23ecbf76467c4980e7f4ae83def8 100644 (file)
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -28,7 +28,11 @@ module Utility.Path (
 ) where
 
 import System.FilePath.ByteString
-import qualified System.FilePath as P
+#ifdef WITH_OSPATH
+import qualified System.OsPath as P
+#else
+import qualified System.FilePath.ByteString as P
+#endif
 import qualified Data.ByteString as B
 import Data.List
 import Data.Maybe
@@ -40,6 +44,7 @@ import Author
 import Utility.Monad
 import Utility.SystemDirectory
 import Utility.Exception
+import Utility.OsPath
 
 #ifdef mingw32_HOST_OS
 import Data.Char
@@ -251,15 +256,16 @@ inSearchPath command = isJust <$> searchPath command
  -
  - Note that this will find commands in PATH that are not executable.
  -}
-searchPath :: String -> IO (Maybe FilePath)
+searchPath :: String -> IO (Maybe OsPath)
 searchPath command
-       | P.isAbsolute command = copyright $ check command
-       | otherwise = P.getSearchPath >>= getM indir
+       | P.isAbsolute command' = copyright $ check command'
+       | otherwise = getSearchPath >>= getM indir . map toOsPath
   where
-       indir d = check $ d P.</> command
+       command' = toOsPath command
+       indir d = check (d P.</> command')
        check f = firstM doesFileExist
 #ifdef mingw32_HOST_OS
-               [f, f ++ ".exe"]
+               [f, f <> ".exe"]
 #else
                [f]
 #endif
@@ -270,10 +276,10 @@ searchPath command
  -
  - Note that this will find commands in PATH that are not executable.
  -}
-searchPathContents :: (FilePath -> Bool) -> IO [FilePath]
+searchPathContents :: (OsPath -> Bool) -> IO [OsPath]
 searchPathContents p =
        filterM doesFileExist 
-               =<< (concat <$> (P.getSearchPath >>= mapM go))
+               =<< (concat <$> (getSearchPath >>= mapM (go . toOsPath)))
   where
        go d = map (d P.</>) . filter p
                <$> catchDefaultIO [] (getDirectoryContents d)

diff --git a/Utility/SystemDirectory.hs b/Utility/SystemDirectory.hs
index a7d60f931e58e5ba1adadb4b1a39208b2d213e35..4ea9b4dbbe176d2b04474f7aaacd289a67fc46ef 100644 (file)
--- a/Utility/SystemDirectory.hs
+++ b/Utility/SystemDirectory.hs
@@ -1,16 +1,107 @@
-{- System.Directory without its conflicting isSymbolicLink and getFileSize.
+{- System.Directory wrapped to use OsPath.
+ -
+ - getFileSize is omitted, use Utility.FileSize instead
  -
  - Copyright 2016 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
--- Disable warnings because only some versions of System.Directory export
--- isSymbolicLink.
-{-# OPTIONS_GHC -fno-warn-tabs -w #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.SystemDirectory (
-       module System.Directory
+       createDirectory,
+       createDirectoryIfMissing,
+       removeDirectory,
+       removeDirectoryRecursive,
+       removePathForcibly,
+       renameDirectory,
+       listDirectory,
+       getDirectoryContents,
+       getCurrentDirectory,
+       setCurrentDirectory,
+       withCurrentDirectory,
+       getTemporaryDirectory,
+       removeFile,
+       renameFile,
+       renamePath,
+       copyFile,
+       canonicalizePath,
+       doesPathExist,
+       doesFileExist,
+       doesDirectoryExist,
+       getModificationTime,
 ) where
 
-import System.Directory hiding (isSymbolicLink, getFileSize)
+#ifdef WITH_OSPATH
+import System.Directory.OsPath
+#else
+import qualified System.Directory as X
+import Data.Time.Clock (UTCTime)
+import Utility.OsPath
+import Utility.FileSystemEncoding
+
+createDirectory :: OsPath -> IO ()
+createDirectory = X.createDirectory . fromRawFilePath
+
+createDirectoryIfMissing :: Bool -> OsPath -> IO ()
+createDirectoryIfMissing b = X.createDirectoryIfMissing b . fromRawFilePath
+
+removeDirectory :: OsPath -> IO ()
+removeDirectory = X.removeDirectory . fromRawFilePath
+
+removeDirectoryRecursive :: OsPath -> IO ()
+removeDirectoryRecursive = X.removeDirectoryRecursive . fromRawFilePath
+
+removePathForcibly :: OsPath -> IO ()
+removePathForcibly = X.removePathForcibly . fromRawFilePath
+
+renameDirectory :: OsPath -> OsPath -> IO ()
+renameDirectory a b = X.renameDirectory (fromRawFilePath a) (fromRawFilePath b)
+
+listDirectory :: OsPath -> IO [OsPath]
+listDirectory p = map toRawFilePath <$> X.listDirectory (fromRawFilePath p)
+
+getDirectoryContents :: OsPath -> IO [OsPath]
+getDirectoryContents p = map toRawFilePath <$> X.getDirectoryContents (fromRawFilePath p)
+
+getCurrentDirectory :: IO OsPath
+getCurrentDirectory = toRawFilePath <$> X.getCurrentDirectory
+
+setCurrentDirectory :: OsPath -> IO ()
+setCurrentDirectory = X.setCurrentDirectory . fromRawFilePath
+
+withCurrentDirectory :: OsPath -> IO a -> IO a
+withCurrentDirectory = X.withCurrentDirectory . fromRawFilePath
+
+getTemporaryDirectory :: IO OsPath
+getTemporaryDirectory = toRawFilePath <$> X.getTemporaryDirectory
+
+removeFile :: OsPath -> IO ()
+removeFile = X.removeFile . fromRawFilePath
+
+renameFile :: OsPath -> OsPath -> IO ()
+renameFile a b = X.renameFile (fromRawFilePath a) (fromRawFilePath b)
+
+renamePath :: OsPath -> OsPath -> IO ()
+renamePath a b = X.renamePath (fromRawFilePath a) (fromRawFilePath b)
+
+copyFile :: OsPath -> OsPath -> IO ()
+copyFile a b = X.copyFile (fromRawFilePath a) (fromRawFilePath b)
+
+canonicalizePath :: OsPath -> IO OsPath
+canonicalizePath p = toRawFilePath <$> X.canonicalizePath (fromRawFilePath p)
+
+doesPathExist :: OsPath -> IO Bool
+doesPathExist = X.doesPathExist . fromRawFilePath
+
+doesFileExist :: OsPath -> IO Bool
+doesFileExist = X.doesFileExist . fromRawFilePath
+
+doesDirectoryExist :: OsPath -> IO Bool
+doesDirectoryExist = X.doesDirectoryExist . fromRawFilePath
+
+getModificationTime :: OsPath -> IO UTCTime
+getModificationTime = X.getModificationTime . fromRawFilePath
+#endif